home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE15 / IDAPI / Bdecmpnt / bdejoc.pas next >
Encoding:
Pascal/Delphi Source File  |  1996-09-12  |  5.3 KB  |  207 lines

  1. {Copyright John O'Connell 1996.  All rights reserved}
  2. unit Bdejoc;
  3.  
  4. interface
  5.  
  6. uses
  7.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  8.   Forms, Dialogs, DB, DbiProcs, DbiTypes, DBTables;
  9.  
  10. type
  11.   TInMemTable = class(TDBDataset)
  12.   private
  13.     { Private declarations }
  14.     FBorrowFrom: TTable;
  15.   protected
  16.     { Protected declarations }
  17.     procedure CheckIsBorrowFromACtive;
  18.   public
  19.     { Public declarations }
  20.     constructor Create(AOwner: TComponent); override;
  21.     function CreateHandle: HDbiCur; override;
  22.   published
  23.     { Published declarations }
  24.     property BorrowFrom: TTable read FBorrowFrom write FBorrowFrom;
  25.   end;
  26.  
  27.   TGenTable = class(TDataSet)
  28.   private
  29.     { Private declarations }
  30.     FHandle: HDbiCur;  {overrides inherited handle property}
  31.     procedure SetHandle(const Value: HDbiCur);
  32.   protected
  33.     { Protected declarations }
  34.   public
  35.     { Public declarations }
  36.     function CreateHandle: HDbiCur; override;
  37.     property Handle: HDbiCur read FHandle write SetHandle;
  38.   published
  39.     { Published declarations }
  40.   end;
  41.  
  42.   TTempTable = class(TTable)
  43.   private
  44.     { Private declarations }
  45.     FBorrowFrom: TDataSet;
  46.     FBorrowInd: boolean;
  47.     procedure SetBorrowFromIndex(Value: boolean);
  48.     procedure SetBorrowFrom(Value: TDataset);
  49.   protected
  50.     { Protected declarations }
  51.     procedure CheckIsBorrowFromACtive;
  52.   public
  53.     { Public declarations }
  54.     constructor Create(AOwner: TComponent); override;
  55.     function CreateHandle: HDbiCur; override;
  56.   published
  57.     { Published declarations }
  58.     property BorrowFrom: TDataset read FBorrowFrom write SetBorrowFrom;
  59.     property BorrowIndexes: boolean read FBorrowInd write SetBorrowFromIndex default False;
  60.   end;
  61.  
  62.  
  63. procedure Register;
  64.  
  65. implementation
  66.  
  67. { TInMemTable }
  68.  
  69. constructor TInMemTable.Create(AOwner: TComponent);
  70. begin
  71.   inherited Create(AOwner);
  72.   FBorrowFrom := nil;
  73. end;
  74.  
  75. function TInMemTable.CreateHandle: HDbiCur;
  76. var PFieldDescs: Pointer;
  77.     Props: CURProps;
  78.     szTableName: DBITBLNAME;
  79. begin
  80.   Result := nil;
  81.   PFieldDescs := nil;
  82.   CheckIsBorrowFromActive;
  83.  
  84.   StrPCopy(szTableName, 'INMEMORYTABLE');
  85.   Check(DbiGetCursorProps(FBorrowFrom.Handle, Props));
  86.   try
  87.     PFieldDescs := AllocMem(Props.iFields * sizeof(FLDDesc));
  88.     Check(DbiGetFieldDescs(FBorrowFrom.Handle, PFieldDescs));
  89.     Check(DbiCreateInMemTable(Database.Handle, szTableName, Props.iFields, PFieldDescs, Result));
  90.   finally
  91.     if Assigned(PFieldDescs) then
  92.       FreeMem(PFieldDescs, Props.iFields * sizeof(FLDDesc));
  93.   end;
  94. end;
  95.  
  96. procedure TInMemTable.CheckIsBorrowFromActive;
  97. begin
  98.   if not FBorrowFrom.Active then
  99.     DatabaseError(format('TTable %s is not open', [FBorrowFrom.Name]));
  100. end;
  101.  
  102. { TGenTable }
  103.  
  104. function TGenTable.CreateHandle: HDbiCur;
  105. begin
  106.   Result := FHandle;
  107. end;
  108.  
  109. procedure TGenTable.SetHandle(const Value: HDbiCur);
  110. begin
  111.   CheckInactive;
  112.   FHandle := Value;
  113. end;
  114.  
  115. { TTempTable }
  116.  
  117. constructor TTempTable.Create(AOwner: TComponent);
  118. begin
  119.   inherited Create(AOwner);
  120.   FBorrowInd := False;
  121. end;
  122.  
  123. procedure TTempTable.SetBorrowFromIndex(Value: boolean);
  124. begin
  125.   CheckInActive;
  126.   FBorrowInd := Value;
  127. end;
  128.  
  129. procedure TTempTable.SetBorrowFrom(Value: TDataSet);
  130. begin
  131.   CheckInActive;
  132.   if Value = Self then
  133.     Exit;
  134.   if Value.InheritsFrom(TTable) or Value.InheritsFrom(TQuery) then
  135.     FBorrowFrom := Value
  136.   else
  137.     DatabaseError('Can only borrow from TQuery or TTable');
  138. end;
  139.  
  140. function TTempTable.CreateHandle: HDbiCur;
  141. var PFieldDescs: Pointer;
  142.     PIndexDescs: pIDXDesc;
  143.     Props: CURProps;
  144.     TblDesc: CRTblDesc;
  145.     szTableName: DBITBLNAME;
  146. begin
  147.   Result      := nil;
  148.   PFieldDescs := nil;
  149.   PIndexDescs := nil;
  150.  
  151.   CheckIsBorrowFromActive;
  152.  
  153.   FillChar(szTableName, sizeof(DBITBLNAME), 0);
  154.   StrCopy(szTableName, 'TMPTABLE');
  155.   Check(DbiGetCursorProps(FBorrowFrom.Handle, Props));
  156.  
  157.   try
  158.     PFieldDescs := AllocMem(Props.iFields * sizeof(FLDDesc));
  159.     Check(DbiGetFieldDescs(FBorrowFrom.Handle, PFieldDescs));
  160.  
  161.     FillChar(TblDesc, sizeof(CRTblDesc), 0);
  162.     with TblDesc do
  163.     begin
  164.       StrCopy(szTblName, szTableName);
  165.       {StrCopy(szTblName, Props.szName);}
  166.       StrCopy(szTblType, Props.szTableType);
  167.       iFldCount := Props.iFields;
  168.       pfldDesc  := PFieldDescs;
  169.       iIdxCount := Props.iIndexes;
  170.  
  171.       if FBorrowInd and (iIdxCount > 0) then
  172.       begin
  173.         PIndexDescs := AllocMem(Props.iIndexes * sizeof(IDXDesc));
  174. {$IFDEF Win32}
  175.         Check(DbiGetIndexDescs(FBorrowFrom.Handle, PIndexDescs));
  176. {$ELSE}
  177.         Check(DbiGetIndexDescs(FBorrowFrom.Handle, PIndexDescs^));
  178. {$ENDIF}
  179.         pidxDesc := PIndexDescs;
  180.       end
  181.       else
  182.         iIdxCount := 0;
  183.     end;
  184.  
  185.     Check(DbiCreateTempTable(Database.Handle, TblDesc, Result));
  186.     Check(DbiSetProp(HDBIObj(Result), curXLTMODE, LongInt(xltFIELD)));
  187.   finally
  188.     if Assigned(PIndexDescs) then
  189.       FreeMem(PIndexDescs, Props.iIndexes * sizeof(IDXDesc));
  190.     if Assigned(PFieldDescs) then
  191.       FreeMem(PFieldDescs, Props.iFields * sizeof(FLDDesc));
  192.   end;
  193. end;
  194.  
  195. procedure TTempTable.CheckIsBorrowFromActive;
  196. begin
  197.   if not FBorrowFrom.Active then
  198.     DatabaseError(format('Dataset %s is not open', [FBorrowFrom.Name]));
  199. end;
  200.  
  201. procedure Register;
  202. begin
  203.   RegisterComponents('JOC', [TInMemTable, TGenTable, TTempTable]);
  204. end;
  205.  
  206. end.
  207.